home *** CD-ROM | disk | FTP | other *** search
/ Aminet 23 / Aminet 23 (1998)(GTI - Schatztruhe)[!][Feb 1998].iso / Aminet / dev / lang / nrcobol_1b.lha / NRCOBOL1b / COBFILES / SORTCLIENT.COB < prev    next >
Text File  |  1997-06-07  |  16KB  |  393 lines
  1.        IDENTIFICATION DIVISION.
  2.        PROGRAM-ID.  SORTCLIENT.
  3.       *PROGRAM DISCRIPTION.
  4.        ENVIRONMENT DIVISION.
  5.        CONFIGURATION SECTION.
  6.        SOURCE-COMPUTER.
  7.        OBJECT-COMPUTER.
  8.        INPUT-OUTPUT SECTION.
  9.        FILE-CONTROL.
  10.            SELECT CLIENT-FILE ASSIGN TO DISK
  11.            ORGANIZATION IS LINE SEQUENTIAL
  12.            ACCESS MODE IS SEQUENTIAL
  13.            FILE STATUS IS WS-FILE-STATUS.
  14.       *
  15.            SELECT S-CLIENT-FILE ASSIGN TO DISK
  16.            ORGANIZATION IS SEQUENTIAL
  17.            ACCESS MODE IS SEQUENTIAL
  18.            FILE STATUS IS WS-S-FILE-STATUS.
  19.       *
  20.            SELECT SORT-CLIENT-FILE ASSIGN TO DISK.
  21.       *
  22.        DATA DIVISION.
  23.        FILE SECTION.
  24.        FD CLIENT-FILE
  25.            LABEL RECORDS STANDARD
  26.            VALUE OF FILE-ID IS "CLIENT.DAT".
  27.        01  IN-CLIENT-REC.
  28.            03  ER-CLAIM-NUMBER          PIC 999V9(4).
  29.            03  ER-CLASS-CODE            PIC 9(6).
  30.            03  ER-REGION                PIC X(4).
  31.            03  ER-PREV-CLAIMS           PIC 99.
  32.            03  ER-PREV-CLAIMS-TOTAL     PIC 9(9).
  33.            03  ER-AMOUNT-CLAIMED        PIC 9(7).
  34.       *
  35.        FD  S-CLIENT-FILE
  36.            LABEL RECORDS STANDARD
  37.            VALUE OF FILE-ID IS "SCLIENT.DAT".
  38.        01  S-CLIENT-REC.
  39.            03  ER-S-CLAIM-NUMBER          PIC 999V9(4).
  40.            03  ER-S-CLASS-CODE            PIC 9(6).
  41.            03  ER-S-REGION                PIC X(4).
  42.            03  ER-S-PREV-CLAIMS           PIC 99.
  43.            03  ER-S-PREV-CLAIMS-TOTAL     PIC 9(9).
  44.            03  ER-S-AMOUNT-CLAIMED        PIC 9(7).
  45.       *
  46.        SD  SORT-CLIENT-FILE.
  47.        01  SD-CLIENT-REC.
  48.            03  SD-CLAIM-NUMBER          PIC 999V9(4).
  49.            03  SD-CLASS-CODE            PIC 9(6).
  50.            03  SD-REGION                PIC X(4).
  51.            03  SD-PREV-CLAIMS           PIC 99.
  52.            03  SD-PREV-CLAIMS-TOTAL     PIC 9(9).
  53.            03  SD-AMOUNT-CLAIMED        PIC 9(7).
  54.       *
  55.        WORKING-STORAGE SECTION.
  56.        01 WS-COUNTERS.
  57.            03 WS-PAGE-COUNT      PIC 99 VALUE 00.
  58.            03 WS-LINE-COUNT      PIC 99 VALUE 00.
  59.            03 WS-CLAIMS-TOTAL        PIC 9(9).
  60.            03 WS-CLAIMS-NUM-TOTAL    PIC 999  VALUE 1.
  61.            03 WS-AVERAGE-CLAIM       PIC 9(7).
  62.        01 WS-STOP-RUN-FLAG       PIC X  VALUE " ".
  63.        01 WS-END-FILE-FLAG       PIC X  VALUE " ".
  64.        01 WS-FILE-STATUS         PIC XX VALUE "00".
  65.        01 WS-S-FILE-STATUS       PIC XX VALUE "00".
  66.       *
  67.        01 WS-TITLE-1.
  68.            03 FILLER  PIC X(22)  VALUE "ASSIGNMENT    10/08/89".
  69.            03 FILLER  PIC X(5)   VALUE SPACES.
  70.            03 FILLER  PIC X(26)  VALUE "FAIL SAFE INSURANCE AGENCY".
  71.            03 FILLER  PIC X(5)   VALUE SPACES.
  72.            03 WS-TITLE-DATE      PIC X(8).
  73.            03 FILLER             PIC X(7).
  74.            03 FILLER             PIC X(5)   VALUE "PAGE ".
  75.            03 WS-TITLE-PAGE-NO   PIC 99.
  76.        01 WS-TITLE-3.
  77.            03 FILLER  PIC X(29)  VALUE SPACES.
  78.            03 FILLER  PIC X(22)  VALUE "INSURANCE CLAIM REPORT".
  79.        01 WS-HEADER-4.
  80.            03 FILLER  PIC X(12)  VALUE "CLAIM NUMBER".
  81.            03 FILLER  PIC X(12)  VALUE SPACES.
  82.            03 FILLER  PIC X(6)   VALUE "REGION".
  83.            03 FILLER  PIC X(12)  VALUE SPACES.
  84.            03 FILLER  PIC X(13)  VALUE "TOTAL CLAIMED".
  85.            03 FILLER  PIC X(10)  VALUE SPACES.
  86.            03 FILLER  PIC X(15)  VALUE "AMOUNT OF CLAIM".
  87.        01 WS-HEADER-5.
  88.            03 FILLER  PIC X(13)  VALUE SPACES.
  89.            03 FILLER  PIC X(10)  VALUE "CLASS CODE".
  90.            03 FILLER  PIC X(6)   VALUE SPACES.
  91.            03 FILLER  PIC X(15)  VALUE "PREVIOUS CLAIMS".
  92.            03 FILLER  PIC X(8)   VALUE SPACES.
  93.            03 FILLER  PIC X(16)  VALUE "AVERAGED CLAIMED".
  94.        01 WS-INSURENCE-REC.
  95.            03 FILLER             PIC X(3)   VALUE SPACES.
  96.            03 FLD-CLAIM-NUMBER   PIC 999V9(4).
  97.            03 FILLER             PIC X(5)   VALUE SPACES.
  98.            03 FLD-CLASS-CODE     PIC X(6).
  99.            03 FILLER             PIC X(4)   VALUE SPACES.
  100.            03 FLD-REGION         PIC X(6).
  101.            03 FILLER             PIC X(6)   VALUE SPACES.
  102.            03 FLD-PREV-CLAIMS    PIC Z9.
  103.            03 FILLER             PIC X(5)   VALUE SPACES.
  104.            03 FLD-PREV-CLAIMS-TOTAL  PIC Z(8)9.
  105.            03 FILLER             PIC X(5)   VALUE SPACES.
  106.            03 FLD-AVG-CLAIMED    PIC Z(6)9.
  107.            03 FILLER             PIC X(5)   VALUE SPACES.
  108.            03 FLD-AMOUNT-CLAIMED PIC Z(8)9.
  109.       *
  110.        01 WS-TOTALS-1.
  111.            03 FILLER             PIC X(35)  VALUE SPACES.
  112.            03 FILLER             PIC X(22)  VALUE
  113.                          "CURRENT TOTAL CLAIMS :".
  114.            03 TOTALS-CURR-CLAIMS PIC ZZZ,ZZZ,ZZ9.
  115.        01 WS-TOTALS-2.
  116.            03 FILLER             PIC X(35)  VALUE SPACES.
  117.            03 FILLER             PIC X(22)  VALUE
  118.                          "NUMBER OF CLAIMS     :".
  119.            03 TOTALS-MAX-CLAIMS  PIC ZZ9.
  120.        01 WS-TOTALS-3.
  121.            03 FILLER             PIC X(35)  VALUE SPACES.
  122.            03 FILLER             PIC X(22)  VALUE
  123.                          "AVERAGE CLAIM        :".
  124.            03 TOTALS-AVG-CLAIMS  PIC Z,ZZZ,ZZ9.
  125.  
  126.  
  127.        01 WS-REAL-DATE.
  128.            03 WS-REAL-YEAR       PIC XX.
  129.            03 WS-REAL-MONTH      PIC XX.
  130.            03 WS-REAL-DAY        PIC XX.
  131.        01 WS-TEMP-DATE.
  132.            03 WS-TEMP-DAY        PIC XX.
  133.            03 FILLER             PIC X    VALUE  "/".
  134.            03 WS-TEMP-MONTH      PIC XX.
  135.            03 FILLER             PIC X    VALUE  "/".
  136.            03 WS-TEMP-YEAR       PIC XX.
  137.        01 WS-CLIENT-REC.
  138.            03  WS-CLAIM-NUMBER          PIC 999V9(4).
  139.            03  WS-CLASS-CODE            PIC 9(6).
  140.            03  WS-REGION                PIC X(4).
  141.            03  WS-PREV-CLAIMS           PIC 99.
  142.            03  WS-PREV-CLAIMS-TOTAL     PIC 9(9).
  143.            03  WS-AMOUNT-CLAIMED        PIC 9(7).
  144.       *
  145.        01 WS-RESPONCE            PIC X.
  146.            88 WS-RESPONCE-S             VALUE "S" "s".
  147.            88 WS-RESPONCE-AD            VALUE "A" "a"
  148.                                               "D" "d".
  149.            88 WS-RESPONCE-A             VALUE "A" "a".
  150.            88 WS-RESPONCE-D             VALUE "D" "d".
  151.            88 WS-RESPONCE-Q             VALUE "Q" "q".
  152.       *
  153.        SCREEN SECTION.
  154.        01 BLANK-SCREEN.
  155.            03 FOREGROUND-COLOR 0 BACKGROUND-COLOR 3.
  156.            03 BLANK SCREEN.
  157.        01 BLANK-LINE.
  158.            03 BLANK LINE.
  159.        01 PROG-DISCRIPTION.
  160.        01 PRINTING-DOC-MESSG.
  161.            03 LINE 3 COLUMN 8        VALUE   "PAGE ".
  162.            03 LINE 3 COLUMN 13       PIC 99   FROM  WS-PAGE-COUNT.
  163.            03 LINE 3 COLUMN 15       VALUE
  164.                    " OF RECORD IS NOW BEING PRINTED".
  165.        01 PROG-FINISH.
  166.            03 LINE 24 COLUMN 8       VALUE
  167.                    "TASK COMPLETE".
  168.        01 MENU.
  169.            03 LINE 10 COLUMN 30 VALUE "MENU".
  170.            03 LINE 11 COLUMN 30 VALUE "----".
  171.            03 LINE 15 COLUMN 19 VALUE 
  172.                                 "PRESS 'A' to sort in ASCENDING".
  173.            03 LINE 16 COLUMN 19 VALUE 
  174.                                 "      'D' to sort in DESCENDING".
  175.            03 LINE 17 COLUMN 19 VALUE 
  176.                                 "      'S' to list to SCREEN ".
  177.            03 LINE 19 COLUMN 19 VALUE 
  178.                                 "      'Q' to quit    MENU   ".
  179.        01 SORTING.
  180.            03 LINE 22 COLUMN 19 VALUE "Sorting file.....".
  181.  
  182.        01 RESPONCE-LINE.
  183.            03 LINE 22 COLUMN 19   PIC X
  184.              TO WS-RESPONCE AUTO.
  185.       *
  186.        01 DIS-TITLE.
  187.            03 LINE 1 COLUMN 1    VALUE "ASSIGNMENT    10/08/89".
  188.            03 LINE 1 COLUMN 28   VALUE "FAIL SAFE INSURANCE AGENCY".
  189.            03 LINE 1 COLUMN 58   PIC X(8)  FROM WS-TEMP-DATE.
  190.  
  191.            03 LINE 1 COLUMN 71   VALUE "PAGE ".
  192.            03 LINE 1 COLUMN 76   PIC 99 FROM WS-PAGE-COUNT.
  193.            03 LINE 3 COLUMN 30   HIGHLIGHT  VALUE
  194.               "INSURANCE CLAIM REPORT".
  195.        01 DIS-HEADER.
  196.            03 LINE 5 COLUMN 1    VALUE "CLAIM NUMBER".
  197.            03 LINE 6 COLUMN 14   VALUE "CLASS CODE".
  198.            03 LINE 5 COLUMN 24   VALUE "REGION".
  199.            03 LINE 6 COLUMN 31   VALUE "PREVIOUS CLAIMES".
  200.            03 LINE 5 COLUMN 42   VALUE "TOTAL CLAIMED".
  201.            03 LINE 6 COLUMN 55   VALUE "AVERAGED CLAIMED".
  202.            03 LINE 5 COLUMN 65   VALUE "AMOUNT OF CLAIM".
  203.        01 NEW-PAGE.
  204.            03 LINE 25 COLUMN 3   VALUE "PRESS ANY KEY FOR NEXT PAGE".
  205.        01 ANY-KEY.
  206.            03 LINE 25 COLUMN 31  PIC X TO WS-RESPONCE AUTO.
  207.      *
  208.        01 ERROR-MESSAGES.
  209.            03 LINE 21 COLUMN 8   VALUE "FILE WOULD NOT OPEN :".
  210.            03 LINE 22 COLUMN 8   VALUE "STATUS ERROR CODE   :".
  211.            03 LINE 22 COLUMN 29  HIGHLIGHT PIC XX
  212.               FROM WS-FILE-STATUS.
  213.            03 LINE 23 COLUMN 8   VALUE "STATUS ERROR CODE   :".
  214.       *
  215.        PROCEDURE DIVISION.
  216.       *
  217.       *********************************************************
  218.       *  Paragraph to open CLIENT-FILE for import and CLIENT-PRINT
  219.       * for export.Should the either file's status be in error,
  220.       * the files are closed and an error message printed along
  221.       * with the status value, Other wise 1000-DISPLAY is called.
  222.       *
  223.        0000-MAIN.
  224.             OPEN INPUT  CLIENT-FILE.
  225.                 IF WS-FILE-STATUS = "00" 
  226.                    PERFORM 1000-DISPLAY
  227.                 ELSE
  228.                    DISPLAY ERROR-MESSAGES.
  229.            CLOSE CLIENT-FILE.
  230.            STOP RUN.
  231.       *
  232.       *******************************************************
  233.       *  This Paragraph displays the program's title and then
  234.       * calls 1100-MENU. When done the paragraph displays a
  235.       * finished message.
  236.       *
  237.        1000-DISPLAY.
  238.            DISPLAY PROG-DISCRIPTION.
  239.            ACCEPT WS-REAL-DATE FROM DATE.
  240.            MOVE WS-REAL-DAY   TO WS-TEMP-DAY.
  241.            MOVE WS-REAL-MONTH TO WS-TEMP-MONTH.
  242.            MOVE WS-REAL-YEAR  TO WS-TEMP-YEAR.
  243.            PERFORM 1100-MENU
  244.                       UNTIL WS-STOP-RUN-FLAG = "S".
  245.            DISPLAY PROG-FINISH.
  246.       *
  247.       *******************************************************
  248.       *  This paragraph provides the user with an option on how
  249.       * to continue.
  250.       *  Expected responce to MENU ;Q TO          QUIT
  251.       *                             S TO LIST TO 'SCREEN'
  252.       *                             P TO LIST TO 'PRINTER'
  253.       *
  254.        1100-MENU.
  255.            MOVE ZERO TO WS-COUNTERS.
  256.            MOVE " " TO WS-END-FILE-FLAG.
  257.            DISPLAY BLANK-SCREEN.
  258.            DISPLAY MENU.
  259.            ACCEPT RESPONCE-LINE.
  260.            IF WS-RESPONCE-Q
  261.                  MOVE "S" TO WS-STOP-RUN-FLAG
  262.               ELSE
  263.               IF WS-RESPONCE-AD
  264.                           PERFORM 1200-SORT-RECORD
  265.                                        UNTIL WS-END-FILE-FLAG = "S"
  266.                    ELSE
  267.                    IF WS-RESPONCE-S
  268.                              PERFORM 1300-LIST-RECORD
  269.                                           UNTIL WS-END-FILE-FLAG = "S".
  270.            CLOSE CLIENT-FILE.
  271.            OPEN  INPUT CLIENT-FILE.
  272.       *
  273.       *
  274.       ******************************************************
  275.       *  This paragraph convets line sequential file to sequential then 
  276.       * sorts the sequential file according to the option selected at the
  277.       * menu.
  278.  
  279.        1200-SORT-RECORD.
  280.             DISPLAY SORTING.
  281.             OPEN OUTPUT S-CLIENT-FILE.
  282.             MOVE " " TO WS-END-FILE-FLAG.
  283.             PERFORM 1210-SEQUENTIAL-REC UNTIL WS-END-FILE-FLAG = "S".
  284.             CLOSE S-CLIENT-FILE.
  285.  
  286.             PERFORM 1220-SORT-REC.
  287.  
  288.             CLOSE CLIENT-FILE.
  289.             OPEN  OUTPUT CLIENT-FILE
  290.                   INPUT  S-CLIENT-FILE.
  291.             MOVE " " TO WS-END-FILE-FLAG.
  292.             PERFORM 1230-NEW-CLIENT UNTIL WS-END-FILE-FLAG = "S".
  293.             CLOSE S-CLIENT-FILE.
  294.  
  295.       * read line sequential to sequential file 
  296.        1210-SEQUENTIAL-REC.
  297.            READ CLIENT-FILE AT END MOVE "S" TO WS-END-FILE-FLAG.
  298.            IF WS-END-FILE-FLAG NOT EQUAL "S"
  299.               WRITE S-CLIENT-REC FROM IN-CLIENT-REC.   
  300.  
  301.        1220-SORT-REC.
  302.            IF WS-RESPONCE-D
  303.               SORT SORT-CLIENT-FILE
  304.                    DESCENDING SD-CLAIM-NUMBER
  305.                    ASCENDING  SD-PREV-CLAIMS
  306.                    USING  S-CLIENT-FILE
  307.                    GIVING S-CLIENT-FILE
  308.            ELSE
  309.               SORT SORT-CLIENT-FILE
  310.                    ASCENDING  SD-CLAIM-NUMBER
  311.                    DESCENDING SD-PREV-CLAIMS
  312.                    USING  S-CLIENT-FILE
  313.                    GIVING S-CLIENT-FILE.
  314.  
  315.        1230-NEW-CLIENT.
  316.            READ S-CLIENT-FILE AT END MOVE "S" TO WS-END-FILE-FLAG.
  317.            IF WS-END-FILE-FLAG NOT EQUAL "S"
  318.               WRITE IN-CLIENT-REC FROM S-CLIENT-REC.
  319.       *
  320.       *******************************************************
  321.       *  As with 1200-PRINT-RECORD except when the screen is full
  322.       * (ie when line count is greater than 22) the screen is paused
  323.       * until any key on the keyboard is pressed.
  324.       *
  325.        1300-LIST-RECORD.
  326.  
  327.            PERFORM 1310-LIST-TITLE.
  328.            PERFORM 1320-READ-LIST-FILE
  329.                          UNTIL WS-LINE-COUNT IS GREATER 21.
  330.            IF WS-END-FILE-FLAG = "S"
  331.                          PERFORM 1330-LIST-TOTALS.
  332.            DISPLAY NEW-PAGE.
  333.            ACCEPT ANY-KEY.
  334.  
  335.       *
  336.       *****************************************************
  337.  
  338.        1310-LIST-TITLE.
  339.  
  340.            ADD 1 TO WS-PAGE-COUNT.
  341.            DISPLAY BLANK-SCREEN.
  342.            MOVE WS-TEMP-DATE TO WS-TITLE-DATE.
  343.            DISPLAY DIS-TITLE.
  344.            DISPLAY DIS-HEADER.
  345.            MOVE 8 TO WS-LINE-COUNT.
  346.       *
  347.       *****************************************************
  348.  
  349.        1320-READ-LIST-FILE.
  350.  
  351.            READ CLIENT-FILE AT END MOVE "S" TO WS-END-FILE-FLAG.
  352.            IF WS-END-FILE-FLAG NOT EQUAL "S"
  353.                  MOVE IN-CLIENT-REC TO WS-CLIENT-REC
  354.                  MOVE WS-LINE-COUNT TO LIN
  355.                  ADD 1 TO WS-PREV-CLAIMS
  356.                  DIVIDE WS-PREV-CLAIMS INTO WS-PREV-CLAIMS-TOTAL
  357.                                      GIVING WS-AVERAGE-CLAIM
  358.  
  359.                  DISPLAY (LIN, 3)  WS-CLAIM-NUMBER        NO
  360.                  DISPLAY (LIN, 16) WS-CLASS-CODE          NO
  361.                  DISPLAY (LIN, 25) WS-REGION              NO
  362.                  DISPLAY (LIN, 35) WS-PREV-CLAIMS         NO
  363.                  DISPLAY (LIN, 44) WS-PREV-CLAIMS-TOTAL   NO
  364.                  DISPLAY (LIN, 58) WS-AVERAGE-CLAIM       NO
  365.                  DISPLAY (LIN, 70) WS-AMOUNT-CLAIMED      NO
  366.  
  367.                  ADD WS-AMOUNT-CLAIMED TO WS-CLAIMS-TOTAL
  368.                  ADD 1 TO WS-CLAIMS-NUM-TOTAL
  369.                  ADD 1 TO WS-LINE-COUNT
  370.            ELSE
  371.                  MOVE 22 TO WS-LINE-COUNT.
  372.       *
  373.       ******************************************************
  374.       *
  375.        1330-LIST-TOTALS.
  376.  
  377.            DIVIDE WS-CLAIMS-NUM-TOTAL INTO WS-CLAIMS-TOTAL
  378.                                    GIVING  WS-AVERAGE-CLAIM.
  379.            MOVE WS-LINE-COUNT TO LIN.
  380.            DISPLAY (LIN  , 35) "CURRENT TOTAL CLAIMS :" NO.
  381.            DISPLAY (LIN  , 65) WS-CLAIMS-TOTAL.
  382.            ADD  1 TO WS-LINE-COUNT.
  383.            MOVE WS-LINE-COUNT TO LIN.
  384.            DISPLAY (LIN  , 35) "NUMBER OF CLAIMS     :" NO.
  385.            DISPLAY (LIN  , 65) WS-CLAIMS-NUM-TOTAL.
  386.            ADD  1 TO WS-LINE-COUNT.
  387.            MOVE WS-LINE-COUNT TO LIN.
  388.            DISPLAY (LIN  , 35) "AVERAGE CLAIM        :" NO.
  389.            DISPLAY (LIN  , 65) WS-AVERAGE-CLAIM.
  390.       *
  391.       *****************************************************
  392.       *
  393.